perm filename MS.F4[NEW,LCS]6 blob
sn#517364 filedate 1980-06-19 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00004 PAGES
00200 C REC PAGE DESCRIPTION
00300 C00001 00001
00400 C00002 00002 C ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00500 C00032 00003
00600 C00050 00004 1860 J2=R2
00700 C00067 ENDMK
00800 C⊗;
00100 C ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
00200 C *** READS DATA FROM CLEFA-B-C-ETC., BDR40,BDI40, ETC.
00300
00400 IMPLICIT INTEGER(A-Q,S-Z)
00500 REAL DIS,DISX,A,B,STFF,CENTR,POS ,UD,XDIS
00600 DIMENSION LST(18),DP(0/7)
00700 COMMON /DL/X22,SAVER,NAME,EXT,IOLD /RRJJ/RJJ2,RJJ(20),JJA
00800 1 /FONT/JFONT /RINP/R(10,80),RPOS(2,50),RI(200)
00900 2 /RMOD/RMODE2,RSET4,IBEAM,
01000 3 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
01100 4 /FRMT/F78F(1),FA1(1),FA5(1),ASK /SIZ/RSZ,JCEN,KCEN
01200 C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
01300 COMMON /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
01400 1 /STF/RSTFAC(0/7),RSTJ2
01500 2 /POSI/STFF(0/7),JJ2,POS /ALF/INP(72),ML
01600 3 /SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
01700 4 /UPDWN/ RL,UD /IDEV/IDEV /NUM/NUM(10),JRD
01800 5 /PLTR/PLT,RHT,DIS,XDIS /PTR/PWDS(350)
01900 CC COMMON /PLTR/PLT,RHT,DIS,XDIS/PTR/PWDS(250),ITEM,L,I,IX
02000 COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
02100 1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
02200 2 /JCHAR/IXX,ISEMI,IBLA,IG,JED,KED,REDIT,RITEM
02300 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /RNW/RNW /MKS/MKS(14)
02400 1 /XRN/RN(3000) /DPY/ST(4000),MEDIT,IGO /DPTR/WDS(350)
02500 2 /MKX/MKX(11) /SC/SSC(72) /YED/YED,IBOX,RBOX/JCLIP/JCLIP
02600 CC COMMON/XRN/RN(2500)/DPY/ST(4000),WDS(250),MEDIT,IGO
02700 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),(I4,
02800 1 INP(4)),(R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(R7,
02900 2 RJQ(5)),(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(I3,INP(3)),
03000 3 (RJ13,RJJ(11))
03100 4,(R11,RJQ(9)),(NJR,R10,RJQ(8)),(R8,RJQ(6)),(RJ3,RJJ(1)),(R9,
03200 5 RJQ(7)),(RX3,RJQ(20)),(ST2,ST(2)),(R13,RJQ(11)),(J8,JQ(6))
03300 6 ,(J13,JQ(11)),(IPOS,POS),(LST(13),K),(LST(14),X),(LST(15),J)
03400 7 ,(I7,INP(7)) ,(ISTAR,MKX(11))
03500 1 ,(MINUS,MKX(10)),(LESS,MKX(3)),(IGT,MKX(4)),(RJ7,RJJ(5))
03600 DATA NUM/'0','1','2','3','4','5','6','7','8','9'/,JRD/0/,ILIM/350/
03700 1 ,STFF/-469.,-346.,-223.,-100.,23.,146.,269.,392./,RSTFAC/8*1./
03800 2 ,LST/'NOTE','REST','CLEF','LINE','SLUR','BEAM','TRILL','STAFF',
03900 3 'MISC','NUMB','LIBRY','CIRCL',0,0,0,'WORD','KSIG','METER'/
04000 4 ,DP/8*1/,RNW/2.44/,LCNT/1/,LIMIT/3000/,DIS/1.0/, RHT/1.0/
04100 5 ,PLUS/'+'/,EXT/'MS '/,COMMA/','/
04200 DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/
04300 C THE GIANT NUMBERS ARE FOR [ AND ]
04400 DATA MKX/'/',';','<','>',-19728949184,-18655207360,'(',')','.'
04500 1,'-','*'/,SSC(14)/'X'/,SSC(15)/';'/,SSC(72)/' '/
04600 C LIMIT IS MAIN ARRAY LENGTH (3000) /SC/SSC ARRAY USED IN MARKS,BEAMS,SLURS
04700 C 350 LIM. ON ITEMS PWDS, WDS (SEE ALSO 571 TO 170)
04800
04900 C***** CALL SEGFIX C FOR UPPER SEGMENTS USED BY MORE THAN 1 JOB (SEGFIX.FAI[TVR])
05000 LCEN=0
05100 MCEN=0
05200 IDEV=5
05300 I1=0
05400 CALL TYPLOC(450,200)
05500 10 CALL DPYX
05600 C THIS DOES DPYSET, ETC.
05700 DO 20 K=1,I
05800 CLEARS ARRAY FOR RESTART OF 'SETUP' ROUTINE
05900 20 RN(K)=0
06000 JFONT=0
06100 CHNG=0
06200 C flag for edit changes (=-1 means a change has been made.)
06300 IOLD=0
06400 C IOLD HOLDS LAST ITEM NUM. EDITED.
06500 IX=0
06600 RSET4=999
06700 QUICK=0
06800 CB=0
06900 C CB IS CENTER-BIG (CENTERING RANGE=6)
07000 UD=1
07100 RL=1
07200 FSCN=LEL
07300 RPOS(1,1)=0
07400 RSZ=.845
07500 JCLIP=525
07600 X22=0
07700 MINUZ=0
07800 C MINUZ IS FLAG FOR '-' SETTING CRLF BACKUP FEATURE (WHEN IN EDIT MODE)
07900 JCEN=0
08000 KCEN=0
08100 PLT=0
08200 PWDS(1)=1
08300 EDQ=-1
08400 RN(2)=0
08500 C FOR RESTART. AVOIDS STAFF CODE NUM.
08600 SAVER=4
08700 DO 30 K=0,7
08800 30 RSTFAC(K)=1.
08900 REDIT=999.
09000 M=1
09100 ITEM=0
09200 ITEMX=0
09300 ZERO=-1
09400 WDS(1)=4
09500 C DATA IN DPY ARRAY STARTS AT WD.4!
09600 I=1
09700 40 SCORE=-1
09800 50 IGO=-1
09900 IF(I1.NE.LRR)GO TO 130
10000 I1=-1
10100 CALL NAMEXT(INP,NAME,EXT)
10200 J2=0
10300 IF(NAME.NE.IBLA)GO TO 2250
10400 C YOU CAN TYPE 'RS NAME' FOR QUICK RESTARTS
10500 GO TO 130
10600
10700 60 CALL NOTWRT
10800 70 IF(M.GT.I)GO TO 80
10900 CC IF(IGO)CALL DPYOUT(1)
11000 IF(IGO)CALL DPYDO(1)
11100 80 ITEM=ITEM+1
11200 IF(ITEM.LT.ILIM)GO TO 90
11300 CALL TYPSTR('**** TOO MANY ITEMS')
11400 CALL TYPINT(ITEM)
11500 CALL TYPSTR('/349')
11600 CALL TYPCRLF
11700 I=PWDS(ILIM)
11800 ITEM=ILIM-1
11900 ST2=WDS(ILIM)
12000 CC CALL DPYOUT(1)
12100 CALL DPYDO(1)
12200 GO TO 40
12300 90 IF(IGO.GT.0)GO TO 100
12400 K=ST2
12500 IF(X22.EQ.0)GO TO 100
12600 CALL BOX(IBOX,RBOX)
12700 ST2=K
12800 100 WDS(ITEM+1)=ST2
12900 IF(EDQ.EQ.-1)GO TO 110
13000 IF(M.LT.I)GO TO 2370
13100 C SL=SAVE AFTER RESETTING LENGTH OF PAGE. (SEE I2 IN SCX)
13200 110 PWDS(ITEM+1)=I
13300 PLT=0
13400 IF(IGO.NE.0)GO TO 120
13500 CC CALL DPYOUT(1)
13600 CALL DPYDO(1)
13700 IF(SCORE.EQ.0)GO TO 1000
13800 C GO GET MORE FROM SCX.
13900 IGO=-1
14000
14100 120 IF(SCORE.EQ.0)GO TO 1070
14200 130 SVST=ST2
14300 C CATCHES TYPO WITH 'C'
14400 K=ITEM+1
14500 IF(X22.EQ.0)GO TO 250
14600 C 'N' SUPPRESSES TYPE-OUT, 'P' OR NEW ITEM RESTORES IT.
14700 IF(QUICK)170,140,290
14800 C -1=QUICK MODE, +1=SUPPRESS TYPE-OUT OF PARAMS, 2=AS 1, BUT RESETS AT C
14900 140 L=RN(MEDIT+1)
15000 K=X22
15100 CXX IF(IDEV.EQ.1)GO TO 250
15200 IF(IDEV.EQ.1)GO TO 290
15300 C 'FILE'CAN BE USED WHILE IN EDIT MODE
15400 CALL TYPCRL
15500 CALL TYPWRD(LST(L))
15600 CALL TYPCRL
15700 CALL TYPFLT(RN(MEDIT+1))
15800 CALL TYPCHR(' ',3)
15900 CALL TYPFLT(RN(MEDIT+2))
16000 CALL TYPCHR(' ',3)
16100 CALL TYPFLT(RN(MEDIT+3))
16200 IF(YED.LT.2)GO TO 260
16300 C YED IS SET AT 426
16400 DO 150 L=4,YED+2
16500 CALL TYPCHR(' (',4)
16600 CALL TYPINT(L)
16700 CALL TYPCHR(') ',2)
16800 150 CALL TYPFLT(RN(MEDIT+L))
16900 CALL TYPCRL
17000 GO TO 260
17100
17200 160 IF(X22.EQ.0)GO TO 260
17300 QUICK=-1
17400 CALL TYPSTR(';=LFT :=RT (=UP )=DN /=HALF *=*2')
17500 CALL TYPCRL
17600 170 CALL FSCAN
17700 C FNUM.FAI=FAST COMMANDS ;=← :=→ (=↑ )= /=HALF *=*2 X=X C=C OTHERS=CR
17800 GO TO 380
17900 GO TO 400
18000 GO TO 410
18100 GO TO 420
18200 GO TO 450
18300 GO TO 470
18400 GO TO 430
18500 GO TO 440
18600 I1=0
18700 180 QUICK=0
18800 GO TO 330
18900
19000 190 FORMAT(2A5)
19100 200 REREAD 190,K,K
19200 IF(I4.NE.LPP)GO TO 210
19300 CALL HELP(K)
19400 GO TO 130
19500 210 CALL LO2UP(K)
19600 C CHANGES LOWER CASE TO UPPER CASE
19700 IF(K.NE.IBLA)GO TO 215
19800 K=FILNAM
19900 CALL TYPSTR('READING ')
20000 CALL TYPWRD(K)
20100 CALL TYPCRL
20200 215 FILNAM=K
20300 C SAVE NAME FOR LATER USE. 'READ' OR 'RR' ALONE READS PREVIOUS FILE.
20400 IF(LOOK(K)+LOOKD(K))GO TO 220
20500 CALL TYPSTR(' FILE NOT FOUND')
20600 GO TO 260
20700 CC2502 CALL IFILE(1,K)
20800 220 CALL FILX(K)
20900 C GOBBLES ET HEADER OR CONVERTS SOS FILE
21000 230 IDEV=1
21100 GO TO 290
21200
21300 240 IDEV=5
21400 GO TO 260
21500 C RESET TO TTY MODE
21600
21700 250 CALL HYDPOG(3)
21800 C TO DELETE VERTICAL LINE (55)
21900 KED=0
22000 QUICK=0
22100 C RESET PARAM TYPE-OUT
22200 RJ13=0
22300 C KILL CENTERING FEATURE FOR NOW
22400 260 IF(IDEV.EQ.1)GO TO 290
22500 CALL TYPCRL
22600 IF(X22.EQ.0)GO TO 270
22700 CALL TYPSTR('**** EDIT ITEM #')
22800 CALL TYPINT(K)
22900 GO TO 280
23000 270 CALL TYPWRD(NAME)
23100 CALL TYPCHR('.',1)
23200 CALL TYPWRD(EXT)
23300 CALL TYPSTR(' TYPE FOR ITEM #')
23400 CALL TYPINT(K)
23500 CALL TYPSTR(' ')
23600 CALL TYPINT(I)
23700 CALL TYPSTR(' ')
23800 CALL TYPINT(SVST)
23900 280 CALL TYPCRL
24000 290 SCORE=-1
24100 CQQ ACCEPT 89,INP
24200 READ(IDEV,700,END=240)INP
24300 CALL LULOOP
24400 IF(I1.EQ.LESS)GO TO 240
24500 C '<' = TEMPORARY ESCAPE FROM 'FILE' MODE
24600 IF(I1.NE.IGT)GO TO 300
24700 IF(X22.NE.0)GO TO 260
24800 C '>' = RETURN TO 'FILE' MODE - IF NOT STILL EDITING.
24900 GO TO 230
25000 300 IF(IDEV.EQ.5)GO TO 320
25100 IF(I7.NE.LTT)GO TO 320
25200 IF(I1.NE.LCC)GO TO 320
25300 C 'ET' DIRECTORY? UGH!!!
25400 310 READ(IDEV,700)INP
25500 IF(I3.NE.ISEMI)GO TO 310
25600 READ(IDEV,700)INP
25700 C READ AGAIN TO GET PAGE MARK - OR SOMETHING???
25800 GO TO 290
25900 C****320 REREAD 2430,J,R2,RJQ
26000 C ↑↑↑ 1/78
26100 320 CALL READX
26200 CRR J=JA
26300 C FIRST CATCHES BLANKS, NUMBERS, ETC.
26400 330 IF(I1.GT.COMMA)GO TO 900
26500 IF(I1.EQ.IBLA)GO TO 900
26600 IF(I1.EQ.LII)GO TO 740
26700 C I = IN, ITEM
26800 IF(I1.EQ.IXX)GO TO 640
26900 C X = EXIT
27000 IF(I1.EQ.LEL)GO TO 680
27100 C L = LEFT, LP=LIGHT PEN
27200 IF(I1.EQ.LUU)GO TO 680
27300 C U = UP
27400 IF(I1.EQ.LRR)GO TO 660
27500 C R = RIGHT, RI=RIT, READ, RS=RESTART
27600 IF(I1.EQ.LDD)GO TO 360
27700 C D = DOWN, DI=DIM, DE=DELETE
27800 IF(I1.EQ.LCC)GO TO 1740
27900 C C = COPY, CR=CRESC., CN=CENTER, CB=CENTER BIG, CH=ON HEAD, CT=ON TAIL
28000 C CX = UNCENTER CP n =CENTER BY NOTE POSITION
28100 IF(I1.EQ.LSS)GO TO 490
28200 C S = SAVE, SPACING STAFF, STAFF, SHOW, SF, SFZ, SCALE, STC=STACCATO
28300 IF(I1.EQ.LEE)GO TO 540
28400 C E ED=EDIT WITH POS. FIRST, E=EDIT WITH LIGHT PEN, ES=EDIT WITH STAFF NUM
28500 IF(I1.EQ.LNN)GO TO 710
28600 C N = NO TYPE
28700 IF(I1.EQ.LPP)GO TO 1150
28800 C P = P,PP,PPP, P N=PRINT PARAM N., PR=PRINT PARAM LIST, POCO, PIU, PZ=PIZZ,
28900 IF(I1.EQ.LAA)GO TO 350
29000 C A = ADJUST TO SET, AD=ADJUST STEMS, AC=ACCEL, AR=ARCO, AT=A TEMPO, ACT=ACCENT
29100 IF(I1.EQ.LQQ)GO TO 160
29200 C Q = QUICK
29300 IF(I1.EQ.LTT)GO TO 770
29400 C T = TYPE TEXT, T=TYPE OUT, TE=TENUTO, TL=TYPLOC
29500 IF(I1.EQ.LFF)GO TO 870
29600 C F = F,FF,FFF,FE=FERMATA,FILE(TO READ COMMAND FILE)
29700 IF(I1.EQ.LHH)GO TO 840
29800 C H = HARMONIC, HW=HEAVY WEDGE, HELP
29900 IF(I1.EQ.COMMA)GO TO 1460
30000 C VALUE OF COMMA IS > VALUE OF PLUS
30100 IF(I1.GE.PLUS)GO TO 900
30200 IF(X22.NE.0)GO TO 260
30300 C NEXT CANNOT HAPPEN IN EDIT MODE.
30400 C O = O=ORDER BY STAFF, OX=ORDER WITHOUT REGARD FOR STAFF NUM.
30500 IF(I1.NE.LOH)GO TO 340
30600 C NEXT FOR REORDERING ITEMS FROM LEFT TO RIGHT, BY STAFF. THEN IT DOES A
30700 IF(I2.EQ.LXX)R2=1
30800 CALL ORDER
30900 340 IF(I1.EQ.LZZ)GO TO 1170
31000 C Z = ZOOM
31100 IF(I1.EQ.LMM)GO TO 1770
31200 C M = MOVE, ME=MENO, MO=MOLTO, MF,MP
31300 IF(I1.EQ.LJJ)GO TO 1770
31400 C J = JUSTIFY JT=JUSTIFY TEXT
31500 IF(I1.EQ.LGG)GO TO 2220
31600 C G = GET, GM=GET MORE
31700 IF(I1.EQ.LWW)GO TO 850
31800 C W = WEDGE ACCENT
31900 IF(I1.EQ.'(')GO TO 1430
32000 IF(I1.EQ.')')GO TO 1450
32100 C LEFT AND RIGHT PARENTHESES
32200 IF(I1.NE.LBB)GO TO 260
32300 C******* ADD MORE LETTER ITEMS HERE *************
32400 C B = BRC=BRACE, BRK=BRACKET -- FOR FRONT OF LINE. BAR=BAR LINE.
32500 IF(X22.NE.0)GO TO 260
32600 CRR*** REREAD 2430,JA,JA,JA,R2,RJQ
32700 CRR*** J=4
32800 JA=4
32900 R7=5
33000 IF(I3.NE.LCC)R7=4
33100 IF(I3.EQ.LRR)R7=0
33200 GO TO 900
33300
33400 350 IF(I2.EQ.LDD)GO TO 570
33500 C 'A' = ALTER(GO TO 112) ADJUST(GO TO 886) ACCEL(GO TO 7813)
33600 C ALIGN=GO TO 886
33700 IF(X22.NE.0)GO TO 580
33800 IF(I2.EQ.LTT)GO TO 1410
33900 C AT=A TEMPO
34000 IF(I2.EQ.LRR)GO TO 1420
34100 C AR=ARCO
34200 IF(I2.NE.LCC)GO TO 1060
34300 IF(I3.EQ.LTT)GO TO 810
34400 C ACT=ACCENT. NEXT FOR AC (=ACCEL.)
34500 RD=80
34600 GO TO 880
34700
34800 360 IF(I2.GE.IBLA)GO TO 650
34900 C 'D' DIM →578, DOWN →883, DELETE →112 OR 883 DP →886
35000 IF(I2.NE.LEE)GO TO 370
35100 IF(X22.NE.0)GO TO 650
35200 GO TO 1060
35300 370 IF(I2.EQ.LPP)GO TO 570
35400 IF(I2.NE.LII)GO TO 260
35500 C NEXT FOR DIM.=82
35600 IF(X22.NE.0)GO TO 260
35700 RD=82
35800 GO TO 880
35900
36000 380 I1=LEL
36100 390 FSCN=I1
36200 GO TO 330
36300 400 I1=LRR
36400 GO TO 390
36500 410 I1=LUU
36600 GO TO 390
36700 420 I1=LDD
36800 GO TO 390
36900 430 I1=IXX
37000 GO TO 180
37100 440 I1=LCC
37200 GO TO 180
37300 450 I1=FSCN
37400 IF(FSCN.EQ.LEL)GO TO 460
37500 IF(FSCN.EQ.LRR)GO TO 460
37600 C NEXT FOR UP-DOWN
37700 UD=UD/2
37800 GO TO 330
37900 460 RL=RL/2
38000 GO TO 330
38100 470 I1=FSCN
38200 IF(I1.EQ.LEL)GO TO 480
38300 IF(I1.EQ.LRR)GO TO 480
38400 UD=UD*2
38500 GO TO 330
38600 480 RL=RL*2
38700 GO TO 330
38800
38900
39000 C 'S'=SET, SA=SAVE, SB=SAVE BIG, SM=BIG+SAME NAME, ST=STAFF, SP=SPC STF
39100 C SC=SPACING SCALE ABOVE STAFF n (99=DELETE IT)
39200 490 IF(I2.EQ.LTT)GO TO 560
39300 IF(I2.EQ.LAA)GO TO 520
39400 IF(I2.EQ.LCC)GO TO 580
39500 IF(I2.EQ.LDD)GO TO 520
39600 IF(I2.EQ.LEE)GO TO 530
39700 IF(I2.EQ.IBLA)GO TO 530
39800 IF(I2.EQ.LPP)GO TO 730
39900 IF(I2.EQ.LHH)JFONT=1
40000 IF(I3.EQ.IXX)JFONT=0
40100 IF(I3.EQ.LPP)JFONT=-1
40200 IF(I3.EQ.LOH)JFONT=-2
40300 IF(I3.EQ.LII)JFONT=-3
40400 C 'SH'(=SHOW) IS SAME AS 44 1. SHOWS TYPE FONTS ON DPY.
40500 C 'SHP' = SHOW ONLY AS 'PRIMITIVE' FONT, 'SHX' = CANCEL FONTS ON DPY.
40600 C 'SHO' = FONT SET (TEMPORARILY) TO 'BDR'; 'SHI' = 'BDI' (ITALICS)
40700 IF(I2.NE.LFF)GO TO 510
40800 RD=45
40900 IF(I3.NE.LZZ)GO TO 880
41000 RD=92
41100 CRR***500 REREAD 2430,JA,JA,JA,R2,RJQ
41200 500 R5=RD
41300 GO TO 890
41400 510 IF(I2.NE.LMM)GO TO 130
41500 C ONLY FOR ST, SA, SB, SM, RS, S, SF=45, SFZ=92
41600 520 IF(X22.NE.0)GO TO 130
41700 SAVER=4
41800 CALL SAVIT
41900 GO TO 130
42000 530 JA=55
42100 R2=RN(MEDIT+3)
42200 C POSITION OF ITEM LOOKED AT.
42300 R3=55.
42400 GO TO 1110
42500 C ABOVE FOR 'S'ET ALIGNMENT
42600 C 'S'=SET ALIGNMENT, 'A'=ALIGN IT. 'M'=MOVER 'C'= COPIER
42700 C 'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;
42800 540 K=-1
42900 DO 550 JA=3,10
43000 550 IF(INP(JA).NE.IBLA)GO TO 570
43100 GO TO 650
43200 CRR***560 FORMAT(A2,21F)
43300 CC IF(X22.NE.0)GO TO 59
43400 560 IF(I3.EQ.LCC)GO TO 830
43500 C STC=STACCATO
43600 570 IF(CHNG.NE.0)GO TO 130
43700 C CAN'T DO 'ST' AND OTHER THINGS AFTER CHANGES IN EDIT MODE.
43800 CRR***580 REREAD 560,K,R2,RJQ
43900 580 JA=55
44000 IF(I2.NE.LCC)GO TO 590
44100 CALL SCL
44200 GO TO 130
44300 590 IF(I2.NE.LDD)GO TO 600
44400 IF(I1.EQ.LAA)JA=190
44500 C 'AD'just stems to beams. 'A'=ADJUST LFT-RT POS. AFTER 'SET' COMMAND
44600 600 IF(I2.EQ.LTT)JA=44
44700 IF(I2.EQ.LNN)GO TO 950
44800 IF(I2.NE.LPP)GO TO 1110
44900 IF(R2.GT.7)GO TO 620
45000 C GO BACK AND RESET ALL IF STF NUM >7
45100 K=R2
45200 JA=0
45300 C USE '8' FOR STAFF 0.
45400 IF(K.GE.0)GO TO 610
45500 C TYPE DP -1 FOR ALL INVISIBLE
45600 DO 611 K=0,7
45700 611 DP(K)=-1
45800 GO TO 120
45900 610 IF(K.EQ.8)K=0
46000 DP(K)=-DP(K)
46100 JA=JA+1
46200 K=RJQ(JA)
46300 IF(K.EQ.0)GO TO 120
46400 C JUMP OUT IF RJQ(JA)=0 OR 99
46500 IF(K.EQ.99)GO TO 1320
46600 C*** 3/74 END WITH '99' TO MAKE DP RIGHT NOW!
46700 GO TO 610
46800 620 DO 630 K=0,7
46900 630 DP(K)=1
47000 GO TO 1320
47100 C TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
47200
47300 C 'LP'=LIGHT PEN. TO BE USED ONLY IN EDIT MODE
47400 640 IF(X22.EQ.0)GO TO 260
47500 C 'X' GO BACK IF NOT IN EDIT MODE -- ALSO R,L,U,D
47600 MINUZ=0
47700 C CLEAR MINUS SIGN FLAG
47800
47900 C NEXT FOR READ, RS, DEL, L,R,U,D
48000 650 IF(IX.EQ.I)GO TO 670
48100 C CAN'T DELETE ('DE') AFTER A PARAM HAS BEEN CHANGED. START OVER.
48200 IF(I2.NE.LEE)GO TO 680
48300 GO TO 130
48400
48500 C R = RIGHT MOVE, RI=RIT., RS=RESTART, READ=READ
48600 660 IF(I2.GE.IBLA)GO TO 680
48700 IF(I2.EQ.LEE)GO TO 200
48800 C ABOVE FOR 'READ'(SAME AS 'FILE')
48900 IF(X22.NE.0)GO TO 260
49000 C GO BACK IF STILL IN EDIT MODE.
49100 IF(I2.EQ.LSS)GO TO 10
49200 C TYPE 'RS' TO RESTART.
49300 CCCC IF(I2.EQ.LEE)GO TO 200
49400 C ABOVE FOR 'READ'(SAME AS 'FILE') NEXT FOR RIT.=37
49500 RD=37
49600 GO TO 880
49700
49800 670 IF(I1.EQ.LCC)GO TO 1650
49900 680 IF(I1.EQ.LEE)GO TO 690
50000 C ABOVE FOR 'ED' (WITH LIGHT PEN)
50100 IF(X22.EQ.0)GO TO 130
50200 C CAN'T MOVE ITEMS UNLESS REALLY IN EDIT MODE!
50300 IF(QUICK.EQ.0.AND.I2.NE.LEE)QUICK=2
50400 C NOW PARAMS DON'T PRINT OUT WHEN USING L,R,U,D***(BUT DE=DELETE)
50500 690 CALL EDIT(JJA)
50600 IF(JA.NE.99)GO TO 1110
50700 CALL DELETE
50800 C DELETE ROUTINE COULD BE PUT DIRECTLY IN HERE.
50900 GO TO 1700
51000 700 FORMAT(72A1)
51100 C TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
51200
51300 710 IF(QUICK.NE.0)GO TO 720
51400 C ↑↑↑ SO 'N n' WILL WORK EVEN AFTER N HAS BEEN SET.
51500 QUICK=1
51600 C TYPE 'N' =NO-TYPE PARAMS TO SUPPRESS TYPE-OUT WHILE EDITING.
51700 IF(X22.NE.0)GO TO 730
51800 720 I1=LII
51900 C 'N n' WHEN NOT IN EDIT MODE = 'I n'<CR>,'N'<CR>
52000 730 IF(I1.NE.LII)GO TO 750
52100 740 IF(I2.EQ.LNN)GO TO 570
52200 C 'IN n,n,n,' MUST BE READ AGAIN AT 886 TO GET n'S CORRECTLY.
52300 JA=223
52400 C JA=223 FOR EDIT MODE
52500 IF(CHNG.NE.0)GO TO 130
52600 C AFTER A CHANGE OF AN ITEM, 'I', ETC. IS ILLEGAL.
52700 IF(R2.EQ.0)GO TO 1110
52800 IF(R2.LT.1.0)GO TO 130
52900 C CATCHES TYPOS. (I.E. DECI. NUMBER AFTER I)
53000 GO TO 1110
53100
53200 750 IF(K)JA=55
53300 C ED 47 -1 = 55 47 -1, ETC.
53400 IF(JA.EQ.101)GO TO 590
53500 IF(I1.NE.LNN)GO TO 760
53600 IF(R2.NE.0)GO TO 720
53700 C IF NO NUM FOLLOWS 'N' GO PRINT OUT CURRENT PARAMS.
53800 GO TO 290
53900
54000 C 'Z' = ZOOM (OLD CODE# 24)
54100 760 IF(I2.NE.LPP)GO TO 770
54200 CRR*** RSET4=R3
54300 RSET4=R2
54400 C SPn SETS "SETUP" STAFF NUMBER
54500 GO TO 130
54600 C 'SP' IS SAME AS 444
54700 C 'P n' = PRINT CURRENT CONTENTS OF PARAM n. (ONLY WHILE IN EDIT MODE.)
54800 770 IF(X22.EQ.0.OR.I2.EQ.LEL)GO TO 910
54900 C JUMP OUT IF 'TL' (TYPLOC)
55000 QUICK=0
55100 C TYPE 'T' TO RESET PARAM TYPE-OUT
55200 IF(R2.EQ.0)GO TO 130
55300 GO TO 720
55400
55500 780 RD=14
55600 C PLUS
55700 CRR***790 REREAD 560,JA,R2,RJQ
55800 CRR790 CONTINUE
55900 800 IF(X22.NE.0)GO TO 130
56000 C CAN'T ENTER NEW ITEM WHILE IN EDIT MODE.
56100 CRR*** J=9
56200 JA=9
56300 R5=RD
56400 IF(R4.EQ.0)R4=15
56500 GO TO 900
56600 810 RD=5
56700 C ACCENT
56800 CRR***820 REREAD 2430,J,J,J,R2,RJQ
56900 CRR820 GO TO 800
57000 GO TO 800
57100 830 RD=7
57200 C STACC.
57300 CRR*** GO TO 820
57400 GO TO 800
57500 840 IF(I3.EQ.LEL)GO TO 200
57600 C JUMP FOR HELP
57700 IF(X22.NE.0)GO TO 260
57800 C CAN'T DO NEXT IF STILL IN EDIT MODE.
57900 RD=13
58000 C HARMONIC
58100 IF(I2.EQ.LWW)RD=21
58200 C HEAVY WEDGE
58300 CRR*** GO TO 790
58400 GO TO 800
58500 850 RD=4
58600 C WEDGE
58700 CRR*** GO TO 790
58800 GO TO 800
58900
59000 CRR***860 REREAD 560,JA,R2,RJQ
59100 860 R5=26
59200 CRR*** J=9
59300 JA=9
59400 IF(R4.EQ.0)R4=12
59500 C FERMATA
59600 GO TO 900
59700
59800 870 IF(I2.EQ.LII)GO TO 200
59900 IF(X22.NE.0)GO TO 260
60000 R5=51
60100 C F=51 FF=52 FFF=53, FE=FERMATA, FILE
60200 IF(I2.EQ.IBLA)GO TO 890
60300 IF(I2.EQ.LEE)GO TO 860
60400 RD=53
60500 IF(I3.NE.IBLA)GO TO 500
60600 RD=52
60700 CRR***880 REREAD 560,JA,R2,RJQ
60800 880 R5=RD
60900 CRR***890 J=3
61000 890 JA=3
61100 IF(R4.EQ.0)R4=-5
61200 C ABOVE IS FOR DIRECT TYPING OF P,PP,PPP,MP,RIT., ETC.
61300 C IF PARAM 4 IS 0, PUTS IT -5 BELOW.
61400 CRR***900 JA=J
61500 900 IF(JA.GT.0)SAVER=SAVER-1
61600 IF(SAVER.LT.0.AND.CHNG.LT.0)CALL SAVIT
61700 C SAVES EVERY 5TH TIME AROUND (IF NO HANGING CHANGES IN DATA)
61800 IF(QUICK.EQ.2)QUICK=0
61900 C RESET QUICK(SUPRESSES PARAM PRINTOUT) IF CRLF AFTER L,R,U,D
62000 IF(X22.NE.0)GO TO 1110
62100 IOLD=0
62200 C RESET FLAG FOR "I" COMMAND
62300 IF(JA.EQ.0)GO TO 130
62400 C CATCHES ZEROS
62500 GO TO 1110
62600 C NEXT FOR ALPHA TEXT ITEMS. 'T'=TYPE
62700 910 IF(I2.NE.LEE)GO TO 920
62800 RD=9
62900 C TENUTO
63000 CRR*** GO TO 790
63100 GO TO 800
63200 920 IF(I2.NE.LEL)GO TO 940
63300 CRR*** J3=R3
63400 CRR*** J4=R4
63500 J3=R2
63600 J4=R3
63700 C 'TL' SET LOCATION OF TYPE OUT ON SCREEN
63800 IF(J4.EQ.0)J4=J3-200
63900 C OMIT 2ND NUM. AND GET N AND N-200.
64000 CRR*** IF(R3.NE.0)GO TO 930
64100 CRR*** IF(R4.NE.0)GO TO 930
64200 IF(R2.NE.0)GO TO 930
64300 IF(R3.NE.0)GO TO 930
64400 J4=0
64500 J3=450
64600 C 'TL' 0 0 PUTS IT BACK TO ORIG. LOC.
64700 930 CALL TYPLOC(J3,J4)
64800 GO TO 130
64900 940 JA=16
65000 C ????'T' = TEST INPUT
65100 J2=R2
65200 M=I
65300 CALL WORDS
65400 SAVER=SAVER-1
65500 IOLD=0
65600 GO TO 1340
65700
65800 950 IF(X22.NE.0)GO TO 130
65900 JA=140
66000 RMODE2=R3
66100 C ????? CHECK THIS TYPE 'IN STF# MODE' ETC. -- SAME AS 140 STF#.
66200 960 SCORE=0
66300 IF(JA.NE.140)GO TO 990
66400 C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
66500 SAVER=-1
66600 RSTF=R2
66700 C DO I NEED THE NEXT???
66800 IF(R3.LT.0)R3=0
66900 DO 970 K=1,ITEM
67000 J=PWDS(K)
67100 IF(RN(J+1).NE.8)GO TO 970
67200 IF(RN(J+2).EQ.R2)GO TO 980
67300 970 CONTINUE
67400 C DIDN'T FIND THIS STAFF
67500 M=LIMIT
67600 C ↑↑ WAS =2000 6/78
67700 IGO=0
67800 JA=8
67900 R3=0
68000 GO TO 1110
68100 980 JA=140
68200 ITCHK=ITEM
68300 ICHK=I
68400 IDPY=ST2
68500 C ALL THIS FOR BACKUPS
68600 990 SPD=ST2
68700 JIT=ITEM
68800 ISC=I
68900 REND=0
69000 C RETAINS ORIGINS OF SCORE SQUENCE
69100 1000 IF(REND.EQ.2)GO TO 990
69200 C FOR READIN CONTINUATION.
69300 M=ISC
69400 1010 IF(JA.EQ.8)GO TO 980
69500 IF(REND)GO TO 1050
69600 C REND=0 GO, -1=NORMAL END, 1=ABORTED.
69700 CALL SCMSS
69800 IOLD=0
69900 IF(REND.EQ.1)GO TO 1050
70000 IF(REND.NE.99)GO TO 1020
70100 I=ICHK
70200 ITEM=ITCHK
70300 ST2=IDPY
70400 CALL ACCPOG(1)
70500 CC CALL DPYOUT(1)
70600 CALL DPYDO(1)
70700 GO TO 1050
70800 1020 ITEM=JIT
70900 J=M
71000 1030 ITEM=ITEM+1
71100 PWDS(ITEM)=J
71200 J=J+RN(J)+3
71300 IF(J.LT.I)GO TO 1030
71400 IF(IBEAM)GO TO 1040
71500 R13=0
71600 R2=RSTF
71700 JA=190
71800 J3=0
71900 CALL HOMER
72000 1040 ITEM=JIT
72100 ST2=SPD
72200 GO TO 1340
72300 1050 SCORE=-1
72400 CALL SHRINK(JIT)
72500 C GETS RID OF ZEROS AT END OF NOTE PARAM LIST.
72600 IGO=-1
72700 JA=16
72800 C FOR TRAP AT 'EDIT'
72900 GO TO 130
73000
73100 1060 IGO=1
73200 CALL GRED
73300 JFONT=0
73400 IF(JA.EQ.98)GO TO 1080
73500 KNT=0
73600 SCORE=0
73700
73800 1070 KNT=KNT+1
73900 C NUM OF ITEMS IN LIST
74000 R11=0
74100 R10=0
74200 R9=0
74300 JA=R(1,KNT)
74400 R2=R(2,KNT)
74500 IF(JA.NE.0)GO TO 1090
74600 C =0 MEANS NO MORE ITEMS.
74700 CC CALL DPYOUT(1)
74800 CALL DPYDO(1)
74900 GO TO 40
75000
75100 1080 X22=0
75200 IGO=-1
75300 CALL DPYNEW
75400 GO TO 120
75500
75600 1090 DO 1100 K=1,6
75700 1100 RJQ(K)=R(K+2,KNT)
75800 1110 M=1
75900 EDQ=-1
76000 IF(JA.EQ.222)GO TO 1650
76100 IF(JA.EQ.2222)GO TO 1670
76200 DO 1120 K=1,20
76300 1120 JQ(K)=RJQ(K)
76400 C X22= ITEM# WHEN EDITING OR DELETING.
76500 IF(X22.NE.0)GO TO 1610
76600 IF(JA.GT.0)GO TO 1130
76700 IF(R2.EQ.0)GO TO 130
76800 C FOR UP, DOWN, LEFT, RIGHT
76900 RJJ2=J2
77000 GO TO 1850
77100 C GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
77200 1130 IF(JA.EQ.223)GO TO 1500
77300 IF(JA.EQ.44)GO TO 1510
77400 C THIS '44' IS SET IN 'EDIT' - IT'S NEVER TYPED.
77500 IF(JA.EQ.55)GO TO 1480
77600 IF(JA.NE.190)GO TO 1860
77700 1140 CALL HOMER
77800 GO TO 1790
77900
78000
78100
78200
78300
78400
00100
00200 1150 IF(X22.EQ.0)GO TO 1350
00300 C WHEN NOT IN EDIT MODE(X22=0) "P n n2" LISTS ALL PARAMS FOR ITEMS n→n2
00400 J2=R2
00500 TYPE 1160,J2,RJJ(J2-2)
00600 C TYPE P n TO SEE FULL CONTENTS OF PARAM. n.
00700 GO TO 130
00800 1160 FORMAT(I,F15.5)
00900
01000 1170 IF(X22.NE.0)GO TO 260
01100 C 'Z' = ZOOM CAN'T DO ZOOM WHILE IN EDIT MODE
01200 IF(I2.NE.LDD.AND.I2.NE.LUU)CALL HYDPOG(2)
01300 C CLEAR SPACING SCALE IF NOT MOVING UP OR DOWN.
01400 JA=24
01500 IGO=0
01600 1180 IF(R2.LT.200)GO TO 1190
01700 R3=AMOD(R2,100.)
01800 R2=(R2-R3)/100.
01900 R4=5*IFIX(9.0/R2)
02000 C Z240 GIVES 2 40 20. Z366 GIVES 3 66 15. Z490 GIVES 4 90 10.
02100 1190 IF(R2.GT.1.OR.R3+R4.NE.0)GO TO 1195
02200 R3=50.0
02300 R4=50.0
02400 C Z1 ONLY ADDS IN 50,50 SO WE CAN ZOOM UP AND DOWN AT ANY SIZE.
02500 1195 IF(I2.GT.0)GO TO 1250
02600 C NEXT SECTION FOR ZLn, ZRn, ZUn, ZDn. n=% OF SCREEN CHANGE OF CENTER PO
02700 CRR*** REREAD 560,R3,R3
02800 C FOR SOME REASON ONLY 'ZD' NEEDS THIS REREAD?!?!?!? FORMAT(A2,21F)
02900 R3=R2
03000 CRR*** ABOVE REPLACES REREAD
03100 IF(R3.EQ.0)R3=RZZZ
03200 RZZZ=R3
03300 C SAVE R3 FOR REPEAT OF COMMAND WITHOUT n.
03400 R3=R3/RZMSZ
03500 C 'ZR10' MEANS MOVE CENTER OF IMAGE 10% OF SCREEN SIZE TO RIGHT.
03600 IF(I2.NE.LRR)GO TO 1220
03700 R3=-R3
03800 1200 R3=RZMX+R3
03900 R4=RZMY
04000 1210 R2=RZMSZ
04100 GO TO 1290
04200 DATA RZMSZ/1.0/,RZMX/50.0/,RZMY/50.0/
04300 C DATA STATEMENT NEEDED TO GET CORRECT NUMS. FOR ZU,ZD, ETC. BEFORE Z1, ETC.
04400 1220 IF(I2.EQ.LEL)GO TO 1200
04500 IF(I2.NE.LUU)GO TO 1240
04600 R3=-R3
04700 1230 R4=RZMY+R3
04800 R3=RZMX
04900 GO TO 1210
05000 1240 IF(I2.EQ.LDD)GO TO 1230
05100
05200 1250 JCLIP=525
05300 C SETS CLIP LIMITS IN CLIP SUBR.
05400 IF(R2.NE.0)GO TO 1270
05500 IF(I2.EQ.LZZ)GO TO 1280
05600 IGO=-1
05700 1260 R2=1.
05800 C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
05900 1270 IF(R2.LE.1)GO TO 1290
06000 JCLIP=511
06100 IF(R3.NE.0)GO TO 1290
06200 1280 CALL ZCRSOR
06300 C 'Zn' (AND NO OTHER NUM) WHERE n >1 ALLOWS YOU SET CENTER WITH LIGHTPEN
06400 1290 RSZ=.845*R2
06500 RZMSZ=R2
06600 RZMX=R3
06700 RZMY=R4
06800 C REMEMBER FACTORS
06900 JCEN=0
07000 KCEN=0
07100 CZOO IF(R2.EQ.1)GO TO 1310
07200 CZOO IF(R2.LT.1)GO TO 1300
07300 JCEN=(R3*10-500)*RSZ
07400 KCEN=(R4*10-480)*RSZ
07500 C NEXT TO RECONSTITUTE SPACING SCALE.
07600 1300 R2=(R4-100.)/100.
07700 C%%%%%%%%%%%%%
07800 IF(R2.LT.0)R2=0
07900 C WE DON'T WORRY IF IT'S TOO HIGH (YET).
08000 1310 R4=0
08100 R2=0
08200 IF(RZMSZ.LT.2)R2=1.
08300 C SETS HEIGHT OF SPACE NUMS. DEPENDING ON ZOOM FACTOR
08400 Cxxxxxxx 12/79 CALL SCL
08500 R2=0
08600 R3=0
08700 R4=0
08800 LCEN=0
08900 MCEN=0
09000 C IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
09100 JFONT=0
09200 1320 M=1
09300 I=PWDS(ITEM+1)
09400 ITEMX=ITEM
09500 C FOR USE IN CENTERING WHOLE RESTS (IN NOTWRT [NTSM.FAI])
09600 ITEM=0
09700 1330 ST2=3
09800 1340 PLT=1
09900 EDQ=0
10000 CALL ACCPOG(1)
10100 IF(JA.EQ.0)GO TO 2370
10200 IF(JA.NE.24)IGO=0
10300 GO TO 2370
10400
10500 1350 IF(I2.EQ.LRR)GO TO 1360
10600 C NOW TYPE 'PR' TO PRINT PARAMETER LIST
10700 R5=42
10800 IF(I2.EQ.IBLA)GO TO 890
10900 IF(I2.EQ.LPP)RD=41
11000 C PPP=40 PP=41 P=42 POCO=72 PIU=91
11100 IF(I2.EQ.LII)RD=91
11200 IF(I2.EQ.LOH)RD=72
11300 IF(I2.EQ.LEL)GO TO 780
11400 C PLUS
11500 IF(I2.EQ.LZZ)GO TO 1370
11600 C PIZZ
11700 IF(I3.EQ.IBLA)GO TO 880
11800 RD=40
11900 GO TO 500
12000 1360 CALL LISTP(LST)
12100 GO TO 130
12200
12300 1370 RA=51857895.
12400 RB=95389999.
12500 C PIZZ.
12600 1380 RD=0
12700 1390 RE=1
12800 CRR***1400 J=16
12900 1400 JA=16
13000 CRR*** REREAD 560,JA,R2,RJQ
13100 R6=RA
13200 R7=RB
13300 R8=RD
13400 IF(R5.EQ.0)R5= RE
13500 IF(R4.EQ.0)R4=14
13600 C 0=PUT IT ABOVE STAFF
13700 GO TO 900
13800 1410 RA=51704789.
13900 RB=74828584.
14000 RD=99999999.
14100 C A TEMPO
14200 GO TO 1390
14300 1420 RA=51708772.
14400 RB=84999999.
14500 C ARCO
14600 GO TO 1380
14700 1430 RA=40999999.
14800 1440 RB=0
14900 GO TO 1380
15000 C LEFT AND RIGHT PARENTHESES AND COMMA
15100 1450 RA=41999999.
15200 GO TO 1440
15300 1460 RA=36999999.
15400 RB=0
15500 RD=0
15600 RE=1.5
15700 C COMMA IS DEFAULT SIZE 1.5
15800 GO TO 1400
15900
16000 1470 CALL JUGGLE
16100 CALL CLRCUR
16200 CALL DPYNEW
16300 CHNG=0
16400 C RESET CHANGE FLAG - CLEAR EDIT MODE ERROR TRAP
16500 IF(JA.EQ.223)GO TO 1690
16600 C FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
16700 IF(ZERO)GO TO 120
16800 X22=ZERO
16900 ZERO=-1
17000 IF(JA.EQ.55)GO TO 1480
17100 IF(JA.EQ.44)GO TO 1510
17200 IF(KED.NE.0)GO TO 1530
17300 GO TO 1700
17400
17500 C 55,POS -- SETS UP ALIGNMENT
17600 1480 IF(I2.NE.LSS)GO TO 1490
17700 CALL EXCH(R2,R3)
17800 J3=R3
17900 C 'ES' IS "EDIT, STAFF, POS., CODE"
18000 C 'ED' IS "EDIT, POS., STAFF, CODE"
18100 1490 CALL BOX(-1,R2)
18200 IF(J4.EQ.0)KED=-1
18300 RITEM=R4
18400 C FOR 'ED POS., STF., CODE#' (STF > 7 = ALL STAVES)
18500 IF(J3.GT.7)KED=-2
18600 RLINE=R2
18700 R2=R3
18800 GO TO 1520
18900
19000 C '223,0' EDITS LAST ITEM ENTERED
19100 1500 REDIT=999.0
19200 IF(R2.NE.0)GO TO 1550
19300 X22=ITEM
19400 IF(IOLD.EQ.0)GO TO 1710
19500 IF(IOLD.LE.ITEM)X22=IOLD
19600 GO TO 1710
19700 1510 KED=1
19800 RITEM=R3
19900 C 'ST*, STF#, CODE# (IF 0, ALL ITEMS COME UP) - STF>7 = ALL STAVES.
20000 IF(R2.GT.7)KED=2
20100 1520 REDIT=R2
20200 C THE STAFF #
20300 JED=1
20400
20500
20600 1530 IF(EDX(RLINE).GE.0)GO TO 1670
20700 CC244 X=ITEM
20800 CC IF(JED.GT.X)GO TO 444
20900 CC DO 144 K=JED,X
21000 CC L=PWDS(K)
21100 CC IF(KED.EQ.-2)GO TO 654
21200 C -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
21300 CC IF(KED.EQ.2)GO TO 656
21400 CC IF(RN(L+2).NE.REDIT)GO TO 144
21500 CC IF(KED)GO TO 654
21600 CC IF(RITEM.EQ.0)GO TO 655
21700 CC656 IF(RITEM.NE.RN(L+1))GO TO 144
21800 CC655 IF(JA.NE.55)GO TO 344
21900 CC654 IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
22000 CC144 CONTINUE
22100 CC444 REDIT=999.
22200 C NO MORE ON LINE
22300 CC R2=0
22400 C SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
22500 CC GO TO 73
22600 CC344 JED=K+1
22700 C FOR NEXT TIME AROUND
22800 CC X22=K
22900 GO TO 1710
23000 C CR MOVES ALONG GIVEN LINE, 222 LEAVES THIS MODE
23100
23200 1540 CALL ACCPOG(1)
23300 IF(I.EQ.IX)ITEM=ITEM-1
23400 GO TO 1560
23500 1550 IF(X22.GT.0)GO TO 1610
23600 1560 IF(R2.NE.0)GO TO 1690
23700 IF(JA.NE.0)MINUZ=0
23800 IF(REDIT.EQ.999)GO TO 1570
23900 IF(JA.GT.0)GO TO 1530
24000
24100 1570 IF(JA.GE.0)GO TO 1580
24200 X22=X22+JA
24300 C FOR TYPING '-n'
24400 GO TO 1600
24500 1580 IF(I1.EQ.PLUS)MINUZ=0
24600 IF(I1.EQ.MINUS)MINUZ=-1
24700 C TYPE '-' WITH NO NUM. TO BACKUP WITH CRLF ONLY
24800 C TYPE '+' TO GO FORWARD
24900 IF(MINUZ.LT.0)GO TO 1590
25000 IF(REDIT.NE.999.)GO TO 1530
25100 C JUMP IF IN 'ED' OR 'ST' MODES
25200 X22=X22+1
25300 GO TO 1700
25400 1590 X22=X22-1
25500 1600 IF(X22.LT.1)GO TO 1670
25600 C EXIT FROM EDIT MODE IF GONE OFF BOTTOM
25700 CC4554 IF(X22.LT.1)X22=1
25800 GO TO 1700
25900
26000 *******
26100 CC1554 X22=X22+1
26200 CC IF(JA.EQ.0)GO TO 4554
26300 CC X22=X22-1+JA
26400 CC GO TO 5554
26500 CC4554 IF(I1.NE.MINUS)GO TO 3554
26600 CC MINUZ=-1
26700 C TYPE '-' WITH NO NUM. TO BACKUP WITH CRLF ONLY
26800 CC3554 IF(MINUZ.LT.0)X22=X22-2
26900 CC IF(X22.LT.1)X22=1
27000 CC GO TO 425
27100
27200 C FOR EDITING
27300 1610 IF(JA.EQ.55)GO TO 1800
27400 1620 IF(JA.NE.223)GO TO 1630
27500 C 'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
27600 KED=0
27700 JED=0
27800 GO TO 1650
27900 1630 IF(JA.EQ.44)GO TO 1800
28000 C FOR '24' WHILE IN EDIT MODE. MAGS WITH CURSOR AS CENTER.
28100 IF(JA.GT.100)GO TO 1640
28200 IF(JA.GT.13)GO TO 130
28300 C PARAM NUM TOO HIGH? LOOKS FOR NEXT ITEM TO EDIT IF <CR>
28400 1640 IF(X22.EQ.0)GO TO 1720
28500 IF(R2.NE.0)GO TO 1720
28600 C BACKS UP WHEN IN EDIT MODE.
28700
28800 IF(JA.GT.0)GO TO 1730
28900 IF(I.EQ.IX)GO TO 1540
29000 IF(CHNG.NE.0.AND.JA.LT.0)GO TO 130
29100 C CAN'T DO '-N' AND OTHER THINGS AFTER CHANGES IN EDIT MODE.
29200 ZERO=X22+1
29300 C '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
29400 1650 IF(X22.EQ.0)GO TO 120
29500 IF(KED.EQ.0)REDIT=999.
29600 1660 IF(I.NE.IX)GO TO 1470
29700 ITEM=ITEM-1
29800 C TO DELETE AN ITEM
29900 1670 X22=0
30000 MINUZ=0
30100 C MINUS SIGN FLAG (WHEN -1, CRLF=BACKUP)
30200 CHNG=0
30300 C RESET CHANGE FLAG
30400 CALL CLRCUR
30500 CALL DPYNEW
30600 IF(REDIT.EQ.999.)GO TO 1680
30700 IF(JA.EQ.55)GO TO 1480
30800 IF(JA.EQ.44)GO TO 1510
30900 1680 IF(R2.EQ.0.OR.R2.GT.ITEM)GO TO 120
31000 C DELETION IN EDIT MODE DOES NOT LEAVE MODE.
31100 1690 X22=R2
31200 1700 IF(X22.GT.ITEM)GO TO 1670
31300 C LEAVES EDIT MODE.
31400 1710 CALL BOXX
31500 CC429 IX=I
31600 CC MEDIT=PWDS(X22)
31700 CC J=2
31800 CC426 Y=RN(MEDIT)+J
31900 CC CALL LOOP(0,Y,1,I,MEDIT,RN)
32000 CC JJA=RN(I+1)
32100 CC YED=Y-2
32200 CC L=I+2
32300 CC DO 422 K=1,11
32400 CC IF(K.GT.YED)GO TO 423
32500 CC RJJ(K)=RN(L+K)
32600 CC GO TO 422
32700 CC423 RJJ(K)=0
32800 CC422 CONTINUE
32900 CC RJJ2=RN(L)
33000 CC IF(IGO.GT.0)GO TO 4231
33100 C NO BOX WHEN IN GROUP EDIT ROUTINE
33200 CC IBOX=I
33300 CC RBOX=RJJ2
33400 CC CALL BOX(IBOX,RBOX)
33500 CC4231 ITEM=ITEM+1
33600 CC ST2=WDS(ITEM)
33700 GO TO 120
33800
33900 1720 IF(JA.EQ.0)GO TO 1850
34000 1730 X=100-JA
34100 IF(X)JA=JA/100
34200 IF(JA.LE.2)GO TO 1820
34300 CALL EQUAL(X)
34400 CC IF(JA.LE.13)GO TO 324
34500 CC JA=JA/10
34600 C ADD 1000 TO PARAM TO MAKE EQUAL TO ANOTHER PARAM
34700 CC X=R2-2.
34800 CC RJJ(JA-2)=RJJ(X)
34900 CC GO TO 6222
35000 CC324 I1=JA-2
35100 CC IF(X)GO TO 224
35200 CC RJJ(I1)=R2
35300 CC GO TO 6222
35400 CC224 RJJ(I1)=RJJ(I1)+R2
35500 GO TO 1840
35600
35700 1740 IF(X22.EQ.0)GO TO 1770
35800 C 'C' = COPY (IN OR OUT OF EDIT MODE) CR=CRESC.
35900 CC IF(I2.EQ.IBLA)GO TO 883
36000 IF(I2.NE.IBLA)GO TO 1760
36100 1750 IF(CHNG.EQ.0)GO TO 130
36200 C CAN'T 'COPY' UNLESS CHANGES WERE MADE.
36300 IOLD=0
36400 GO TO 650
36500 1760 IF(I2.EQ.LPP)GO TO 1761
36525 C CP n =CENTER BY NOTE POSITION
36550 IF(R2.NE.0)GO TO 1750
36600 C IS THERE A NUMBER AFTER C
36700 R2=1
36800 C CN=CENTER, CH=AT HEAD, CT=AT TAIL, CX=EXIT FROM CENTERING MODE.
36900 JA=13
37000 IF(I2.EQ.IXX)R2=0
37100 IF(I2.EQ.LHH)R2=-R2
37200 IF(I2.EQ.LTT)R2=-2
37300 IF(I2.EQ.LBB)CB=6
37400 IF(I2.EQ.LVV.OR.I2.EQ.LDD)CB=-1
37500 IF(I3.EQ.LVV)CB=CB-10
37600 C TYPE 'CB' FOR CENTER-BIG (BIG RANGE =6) ***** 'CV'=SET CURVE OF SLUR
37700 C CBV, CHV, CTV WILL SET CURVE AND DO CENTERING. CD CENTERS DASH BETWEEN WDS.
37800 GO TO 1110
37820 1761 CALL SETLET
37860 GO TO 1110
38000 1770 IF(I2.EQ.IBLA)GO TO 1780
38100 C NEXT FOR ME=MENO=81 MOLTO=90 CRESC.=70 MP=43 MF=50, ALSO 'MACRO'
38200 RD=43
38300 IF(I2.EQ.LAA)GO TO 2400
38400 IF(I2.EQ.LFF)RD=50
38500 IF(I2.EQ.LOH)RD=90
38600 IF(I2.EQ.LEE)RD=81
38700 IF(I2.EQ.LRR)RD=70
38800 IF(I2.NE.LTT)GO TO 880
38900 C JT=JUSTIFY TEXT (ONLY 1 STAFF AT A TIME)
39000 1780 CALL MOVER
39100 IF(R2.GE.99)GO TO 260
39200 C 99(+)=BACKUP OUT OF MOVER ETC.
39300 IGO=0
39400 JFONT=0
39500 C SO IT WON'T DO ALL FONT LOOKUPS.
39600 1790 IF(JJ2)GO TO 130
39700 M=PWDS(JJ2)
39800 I=PWDS(ITEM+1)
39900 ITEM=JJ2-1
40000 ST2=WDS(JJ2)
40100 C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
40200 GO TO 1340
40300
40400 1800 IF(REDIT.NE.55.)REDIT=0
40500 C NEEDED FOR 'S'ET, THEN 'A'LIGNE ROUTINE
40600 IF(I2.NE.IBLA)GO TO 1660
40700 C WE GET HERE WHEN TYPING 'ST' OR 'ED' WHEN ALREADY IN EDIT MODE.
40800 IF(R2.EQ.0)GO TO 1810
40900 IF(CHNG.NE.0)GO TO 130
41000 C CATCH 'S'ET AFTER A CHANGE WAS MADE.
41100 GO TO 1660
41200 C GO PAST HERE ONLY FOR 'A'LIGN
41300 1810 IF(KED.GE.0)RLINE=RJ3
41400 RJ3=RLINE
41500 GO TO 1840
41600 C FOR '55' ALIGNING
41700 1820 IF(X)GO TO 1830
41800 CALL PARCH(JA,JJA,R2)
41900 GO TO 1840
42000 1830 RJJ2=R2+RJJ2
42100 C ARRAYS NEED 2O LOCATIONS HERE.
42200 C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122 4,13 5,-2 ETC.)
42300 1840 CALL RJED
42400 1850 CALL RJED2
42500 C BELOW IS NOW IN 'LOOP.FAI'
42600 CC6222 DO 1222 K=1,20,2
42700 CC L=JQ(K)
42800 CC IF(L.EQ.0)GO TO 6221
42900 C '600 2' WILL ADD 2 TO PARAM 6. '3000 6' SETS P3=P6.
43000 CC RD=RJQ(K+1)
43100 CC X=L
43200 CC IF(L.LT.100)GO TO 223
43300 CC IF(L.LT.2000)GO TO 5223
43400 CC X=L/1000
43500 CC L=JQ(K+1)-2
43600 CC RD=RJJ(L)
43700 CC GO TO 2223
43800 CC5223 X=L/100
43900 CC IF(X.EQ.2)GO TO 1223
44000 CC RD=RJJ(X-2)+RD
44100 CC GO TO 2223
44200 CC1223 RD=RJJ2+RD
44300 CC223 IF(X.LE.2)GO TO 3223
44400 CC2223 RJJ(X-2)=RD
44500 CC GO TO 1222
44600 CC3223 CALL PARCH(X,JJA,RD)
44700 C NOW P1 CAN BE CHANGED IN EDIT MODE -- BE CAREFUL,,,,!!!!!!
44800 CC1222 CONTINUE
44900 C*** LOOP SET TO 11 (20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
45000 CC6221 DO 5514 K=1,11
45100 CC R2=RJJ(K)
45200 CC RJQ(K)=R2
45300 CC5514 JQ(K)=R2
45400 CC R2=RJJ2
45500 CC JA=JJA
45600 CC ITEM=ITEM-1
45700 CC IF(ITEM)ITEM=0
45800 ST2=WDS(ITEM+1)
45900 I=PWDS(ITEM+1)
46000 IF(X22.NE.0)CHNG=-1
46100 C SET CHANGE FLAG TO TRAP EDIT MODE ERRORS. (CLEARED AT 172)
46200 CALL DPYNEW
46300
46400
46500
46600
46700
46800
00100 1860 J2=R2
00200 IF(J2.LT.0)GO TO 130
00300 IF(J2.GT.7)GO TO 130
00400 C STOPS TYPO ERROR ON STAFF NUM. (<0, >7)
00500 RSTJ2=RSTFAC(J2)
00600 C* IF(JA.NE.2)GO TO 163
00700 C* IF(R8.EQ.0)GO TO 163
00800 C* IF(R8.EQ.-1)GO TO 163
00900 C* IF(R8.EQ.-4)GO TO 163
01000 C R8=0=AS IS; -1=WHOLE REST; >0=NUMBER OVER REST; -2=CENTERED
01100 C R8=-3 = CENTERED REST (BUT NOT CHANGED TO WHOLE)
01200 C R8=-4 = MEASURE REPEAT SIGN. =-5 = REPEAT SIGN CENTERED.
01300 C* K=ITEM
01400 C ITEM+1 IS CURRENT ITEM IN QUICK RUN-THROUGHS.
01500 C* IF(X22.NE.0)K=X22-1
01600 C* RD=1.75*RSTJ2
01700 C* L=PWDS(K+2)
01800 C* IF(RN(L+1).NE.4)GO TO 164
01900 C GO ON IF NEXT ISN'T BAR LINE (CODE 4. NEXT FINDS OTHER LINES!!)
02000 C* IF(RN(L+2).NE.R2)GO TO 164
02100 C* RB=RN(L+3)
02200 C* L=PWDS(K)
02300 C CHECK PREV. AND NEXT ITEM. IF NOT BAR, DON'T TRY TO CENTER!
02400 C* IF(RN(L+1).NE.4)GO TO 164
02500 C* IF(RN(L+2).NE.R2)GO TO 164
02600 C JUMP IF NOT ON SAME STAFF
02700 C* RA=RN(L+3)
02800 C* R3=RA+(RB-RA)/2-1.75*RSTJ2
02900 C*164 IF(PLT.EQ.0)GO TO 160
03000 C* RN(PWDS(K+1)+3)=R3
03100 C ******* A DANGEROUS PLACE. KEEP TRACK OF THIS
03200 C* GO TO 5541
03300
03400 1870 IF(JA.EQ.16)GO TO 1910
03500 IF(PLT.NE.0)GO TO 2080
03600 IF(JA.NE.2)GO TO 1880
03700 IF(R8.NE.0)GO TO 2010
03800 IF(R9.NE.0)R9=0
03900 GO TO 2010
04000 1880 IF(JA.NE.8)GO TO 1900
04100 IF(R9.NE.1)GO TO 2010
04200 L=7
04300 K='INST.'
04400 C RJQ(7) IS R9
04500 1890 RA=RN(MEDIT+L+2)
04600 CALL TYPCHR(RA,5)
04700 CALL TYPCRL
04800 CALL TYPSTR('TYPE ')
04900 CALL TYPCHR(K,5)
05000 CALL TYPSTR(' NAME ')
05100 READ(IDEV,FA5)RD
05200 CALL LO2UP(RD)
05300 RJQ(L)=RD
05400 IF(RD.NE.' ')GO TO 2010
05500 IF(RN(MEDIT).LT.L)RA=0
05600 C RESTORES NAME IF THERE WAS ONE ALREADY. ELSE=0
05700 RJQ(L)=RA
05800 C WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
05900 GO TO 2010
06000 CF371 FORMAT(A5,A1,A3)
06100 1900 IF(JA.NE.11)GO TO 2010
06200 C ↑↑↑↑ WAS - TO 63
06300 IF(J10.NE.1)GO TO 2010
06400 K='FILE'
06500 L=8
06600 C P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
06700 GO TO 1890
06800 C IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
06900 1910 RD=R5
07000 IF(RD.GE.100)RD=RD-100
07100 C ADD 100 TO SZ TO MAKE TEXT APPEAR IN ALL SEPARATE PARTS OF ORCH. SCORE
07200 IF(J10.EQ.0)GO TO 2000
07300 L=ITEM
07400 IF(X22.NE.0)L=X22-1
07500 IF(J10.EQ.1)GO TO 1980
07600 C TEMP. FIX TO CNVT TEXT FORMAT TO NEW STYLE. "10 99"
07700 C* IF(J10.NE.99)GO TO 1950
07800 C* X=PWDS(X22)+6
07900 C* DO 1920 L=X,X+2
08000 C* RB=RN(L)
08100 C* K=RB
08200 C CHECKS TO SEE WHICH FORMAT
08300 C*1920 IF(K.NE.RB)GO TO 1930
08400 C* GO TO 70
08500 C*1930 DO 1940 L=X,X+2
08600 C*1940 RN(L)=RN(L)*100.
08700 C* GO TO 70
08800
08900 C NEXT FOR CENTERING TEXT. P10>1
09000 1950 RB=0
09100 X=PWDS(L+1)
09200 1960 L=L+1
09300 K=PWDS(L)
09400 RB=RB+RN(K+9)
09500 C ADD SPACE NEEDED
09600 K=PWDS(L+1)
09700 IF(RN(K+1).NE.16)GO TO 1970
09800 IF(RN(K).EQ.8)GO TO 1960
09900 C GO BACK IF MORE LETTERS TO COME
10000 1970 R3=R10-(RB-3.4)*RD*RSTJ2/2.
10100 C +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
10200 R10=0
10300 IF(RN(X).EQ.8)RN(X+10)=0
10400 RN(X+3)=R3
10500 C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
10600 GO TO 2000
10700 1980 K=PWDS(L)
10800 R3=AMOD(RN(K+5),100.)*RSTJ2*RN(K+9)+RN(K+3)
10900 C AMOD BECAUSE P5+100 IS USED FOR PARTS PROGRAM.
11000 R4=RN(K+4)
11100 R5=RN(K+5)
11200 R2=RN(K+2)
11300 J2=R2
11400 L=PWDS(L+1)
11500 DO 1990 JJA=3,5
11600 1990 RN(L+JJA)=RJQ(JJA-2)
11700 RN(L+2)=R2
11800 2000 IF(PLT.NE.0)GO TO 2080
11900 2010 RJ3=R3
12000 JJA=JA
12100 IF(R8.NE.0)GO TO 2020
12200 IF(JA.EQ.1)R8=999.
12300 C 999=0 FOR STEM EXTENSIONS.
12400 C USES ONLY 10 PARAMETERS BEYOND JA, J2
12500 2020 CALL MSSLUP
12600 IF(JA.NE.6)GO TO 2040
12700 CX I DON'T THINK THIS NEXT IS NEEDED NOW. 9/78 IF(J13.EQ.0)GO TO 171
12800 CX R2=X22
12900 CX X22=0
13000 CX R3=R13
13100 CX J3=J13
13200 CX R4=R11
13300 C RESET HOMING RANGE (DEFAULT=3) WITH P11.
13400 CX CALL CLRCUR
13500 CX R13=0
13600 C TYPE 13, n WITH BEAMS TO ADJUST IN RE. TO OTHER STAFF(LIKE OLD 'AD')
13700 CX JA=190
13800 CX GO TO 271
13900 2030 CALL HOMER
14000
14100 2040 IF(R13.EQ.0)GO TO 2070
14200 RD=R11
14300 IF(CB.EQ.0)GO TO 2050
14400 C *** CB = CENTER-BIG I.E. BIG RANGE FOR CENTERING -- 6 UNITS. (CAN VAR
14500 X=CB+10
14600 IF(CB.LT.-1)CB=X
14700 C CBV NOW=-4, CHV AND CTV =-10
14800 IF(RD.EQ.0)R11=CB
14900 IF(JA.NE.4)GO TO 2045
15000 IF(CB.GE.0)GO TO 2050
15100 CALL DASHES(ITEM,R2,RJQ)
15200 C SUBR. DASHES WILL CENTER DASH BETWEEN TO WORDS OR SYLLABLES. (TYPE 'CD')
15300 GO TO 2060
15400 2045 IF(JA.NE.5.OR.CB.GT.0)GO TO 2050
15500 C *** CV = SET CURVE OF SLUR. (FOR USE AFTER SPACE CHANGES, ETC.)
15600 R7=RCURVE(R3)
15700 CC R7=0.9+(R6-R3)/25.+ABS(R4-R5)/10.
15800 C SAME FORMULA AS FOUND IN SLURZ ROUTINE. FUNCTION CURVE IS IN LOOP
15900 CC IF(R7)RB=-RB
16000 CC DONE IN 'RCURVE'*** R7=RB
16100 RJ7=R7
16200 IF(X.GT.0)GO TO 2060
16300 GO TO 2060
16400 2050 CALL HOMER
16500 2060 CB=0
16600 R11=RD
16700 C R11 GETS CHANGED IN 'HOMER'
16800 CC IF(JA.EQ.2.AND.R9.NE.0)CALL RSTCEN
16900 C RSTCEN IS FOR CENTERING WHOLE RESTS.
17000 IF(JA.EQ.10)R3=R3+RSTJ2
17100 IF(JA.NE.9)GO TO 2070
17200 IF(J5.GT.3)GO TO 2070
17300 CALL NOZERO(R6)
17400 R3=R3+RSTJ2+2.*RSTJ2*R6
17500 C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
17600 C IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
17700 C P13=-1 POSITIONS ITEM ABOVE OR BELOW NOTE, =-2 JUST BEYOND STEM.
17800 C CODE 10 (NUMBERS) SPACED TO LEFT AS WELL AS CODE 9, P5=1,2,3 (FLAT,SHR
17900 C **** FOR '0' EDITS ******
18000 2070 CALL LUP2
18100 2080 IF(DP(J2).GE.0)GO TO 2090
18200 IF(JA.NE.8)GO TO 70
18300 C NOW GET SIZE FACTOR, IF IT'S THERE. (NEEDED IN 'SCORE' SECTION.)
18400 IF(R5.NE.0)RSTFAC(J2)=R5
18500 GO TO 70
18600 C*** 3/74 NEW DP SYSTEM
18700 C WHAT ABOUT EDITS?*******
18800 2090 POS=STFF(J2)
18900 RX3=R3
19000 C SAVES IT IN RJQ(20) FOR OTHER ROUTINES.
19100 J3=ROFF(RHORZ(R3))
19200 C LINE IS DIVIDED INTO 200 POINTS.
19300 CALL CENTX
19400 C SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
19500 R3=J3
19600 IF(JA.LE.2)GO TO 60
19700 2100 GO TO(2430,2430,2130,2210,2140, 2190,2150,2180,60,2120, 2130,2200)
19800 1,JA
19900 GO TO (2150,2160,2170),JA-15
20000 C FOR 16,17,18 (WORDS, KSIG, METER)
20100 IF(JA.EQ.99)GO TO 70
20200 C FOR PART EXTRACTOR TRANSPOSER - KEY SIG=0
20300 IF(JA.NE.33.AND.JA.NE.44)GO TO 2110
20400 JA=JA/11
20500 C THIS IS TEMPORARY - TO READ PAGE TEMP. FILES.
20600 GO TO 2100
20700
20800 2110 I=PWDS(ITEM+1)
20900 GO TO 130
21000 C 44 1; JFONT=ONE DISPLAYS FONTS - THIS ALSO CATCHES SOME TYPOS
21100
21200 2120 CALL MAKNUM(R5)
21300 GO TO 70
21400
21500 2130 CALL CLEFS
21600 GO TO 70
21700
21800 2140 CALL SLUR
21900 GO TO 70
22000
22100 2150 CALL ALPHA
22200 GO TO 70
22300
22400 2160 CALL KSIG
22500 GO TO 70
22600
22700 2170 CALL METER
22800 GO TO 70
22900
23000 2180 IF(R2.EQ.0)RMOV=R8
23100 CALL STAFF
23200 GO TO 70
23300 CC625 IF(J10.LT.100)GO TO 1625
23400 CC CALL BEAMX
23500 CC GO TO 160
23600
23700 2190 CALL BEAMX
23800 CC625 CALL BMSTF
23900 GO TO 70
24000 C BEAMS, STAFF LINES ****
24100 2200 CALL CIRCLE
24200 GO TO 70
24300
24400 2210 CALL ITMSUB
24500 C BAR LINES, ETC.
24600 GO TO 70
24700
24800 C TO GET DISPLAY: 'G'; 'GM' ADDS TO DPY;
24900 CC120 IF(X22.NE.0)GO TO 59
25000 C GO BACK IF STILL IN EDIT MODE
25100 2220 J2=0
25200 IF(I.EQ.1)GO TO 2230
25300 L=NAME
25400 X=EXT
25500 IF(I2.EQ.IBLA)GO TO 2110
25600 J2=-1
25700 I2=(I2-'0')/536870912
25800 C TURN ASCII INTO INTEGER.
25900 IF(I2.GT.9.OR.I2.LT.0)GO TO 2230
26000 C VERT. STEPS PER INCH = 23.9 (CONSIDER STAFF SIZE FACTOR TOO)
26100 R2=I2
26200 J2=1
26300 C 'GM'=GET MORE(BUT OLD OUTPUT NAME IS RESTORED AT 2207)
26400 C 'Gn'=GET MORE AND PUT IT ON STAFF n AT POS. OF STAFF 0'S P8.
26500 C ANYTHING AFTER 'G' BUT A NUMBER IS TAKEN AS 'GM'.
26600 2230 I1=-1
26700 CALL NAMEXT(INP,NAME,EXT)
26800 C NOW TYPE 'G NAME' OR 'GM NAME'
26900 IF(NAME.NE.IBLA)GO TO 2250
27000 2240 CALL TYPSTR(' NAME.EXT? ')
27100 READ(IDEV,700,END=240)INP
27200 C GO PUT A1'S INTO A5, ETC.
27300 CALL NAMEXT(INP,NAME,EXT)
27400 IF(NAME.EQ.IBLA)GO TO 2270
27500 IF(NAME.NE.'99')GO TO 2250
27600 C TYPE '99' TO BACK OUT OF 'SAVE'.
27700 NAME=L
27800 EXT=X
27900 GO TO 130
28000 2250 IF(I1.NE.LESS)GO TO 2260
28100 IDEV=5
28200 GO TO 2240
28300 2260 CALL LO2UP(NAME)
28400 CALL LO2UP(EXT)
28500 IF(LOOKX(NAME,EXT).EQ.0)GO TO 2240
28600 C FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
28700 2270 JA=-1
28800 C -1 IS FOR 8852+3
28900 2280 J=ITEM+1
29000 IF(NAME.NE.IBLA)GO TO 2290
29100 C*** CALL GETEXT('TMP','MS ')
29200 C**** CALL INMUS('TMP','MS',RN(I),PWDS(J),RSTFAC)
29300 K='TMP'
29400 JJ2='MS'
29500 GO TO 2300
29600 C***2290 CALL GETEXT(NAME,EXT)
29700 C**** 2290 CALL INMUS(NAME,EXT,RN(I),PWDS(J),RSTFAC)
29800 2290 K=NAME
29900 JJ2=EXT
30000 2300 CALL INMUS(K,JJ2,RN(I),PWDS(J),RSTFAC)
30100 IF(J2.EQ.0)GO TO 2310
30200 C****2300 IF(J2.EQ.0)GO TO 2310
30300 NAME=L
30400 EXT=X
30500 C ABOVE GETS BACK ORIGINAL NAME WITH 'GM' AND 'Gn'
30600 2310 RSTF=0
30700 C*** CALL EXTIN(RSTFAC,128)
30800 C*** CALL EXTIN(PWDS(J),JJ2)
30900 C*** CALL EXTIN(RN(I),IPOS)
31000 ITEM=ITEM+JJ2-2
31100 CCCC IF(J2)GO TO 2203
31200 IF(J2)2350,2320,2330
31300 CC IF(I2.EQ.IM)GO TO 2203
31400 C J2=-1,1=GM *******'GET MORE' DOES NOT GET MOTIVE LIST OF NEW FILE.****
31500 2320 IF(LCNT.GT.1)CALL EXTIN(LIST,LCNT)
31600 I=IPOS
31700 IF(RSTF.EQ.0)GO TO 1320
31800 C (END OF V ARRAY)RSTF=-1 MEANS READ THE DPY BUFFER
31900 CALL EXTIN(ST,4302)
32000 CALL DPYNEW
32100 GO TO 130
32200
32300 2330 DO 2340 K=1,ITEM
32400 IF(RN(PWDS(K)+1).NE.8)GO TO 2340
32500 J3=PWDS(K)
32600 IF(RN(J3+2).NE.0)GO TO 2340
32700 R8=RN(J3+8)
32800 C ASSUMES SPACE INFO IS IN P8. GET IT.
32900 C NEXT FOR VERTICAL SPACING OF NEW STAFF TO BE READ.
33000 R5=23.9/RSTFAC(0)
33100 R3=.73*R2
33200 C INCHES BETWEEN STAVES=.73
33300 R4=(R8-R3)*R5
33400 C R4=CHANGE FROM NORMAL POSITION FOR INCOMING STAFF.
33500 GO TO 2350
33600 2340 CONTINUE
33700 C IF NO STAFF 0 WAS FOUND R4=0
33800 R4=0
33900 2350 M=I-1
34000 DO 2360 K=J,J+JJ2-2
34100 PWDS(K)=PWDS(K)+M
34200 IF(J2.LE.0)GO TO 2360
34300 C NEXT FOR GET-MORE AND PUT ON STAFF #R2
34400 J3=PWDS(K)
34500 RN(J3+2)=R2
34600 IF(RN(J3+1).NE.8)GO TO 2360
34700 RN(J3+4)=R4
34800 C SET HEIGHT OF STAFF - DEPENDANT UPON P8 OF STAFF 0.
34900 CCC IF(RN(J3).GE.6)RN(J3+8)=0
35000 C ZERO SPACING PARAM IN UPPER STAVES.
35100 2360 CONTINUE
35200 GO TO 1320
35300 M=IX
35400 C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
35500 C (J8) P8=1 OR 2 FOR 2-PASS PLOTS
35600 C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
35700 C RMOV HAS INCHES FROM P8 OF STAFF 0.
35800 C R6=1 FOR NO MOVE AT END. R7=INCHES TO MOVE FOR NEW STAFF 0.
35900 C RE. R7:DISTANCE IS MEASURED FROM BOTTOM LINE OF STANDARD POSITION
36000 C OF STAFF 0 UP TO LOWEST!! POINT FOUND IN FOLLOWING FILE. THEN
36100 C NEXT SHIFT IS AGAIN FROM STANDARD STF.0 TO NEXT FILE'S LOW POINT.
36200 C MOVES PLOTTER UP IF P5=0.
36300
36400 C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
36500 2370 IF(M.GE.I)GO TO 2390
36600 IF(IGO.EQ.0)GO TO 2380
36700 C USE "Z" TO DO FIXUP WHEN LIST IS SCRAMBLED !?X@!ZQ
36800 IF(M.EQ.PWDS(ITEM+1))GO TO 2380
36900 K=ITEM+1
37000 CALL TYPSTR(' FIXING ITEM ')
37100 CALL TYPINT(K)
37200 CALL TYPCRL
37300 PWDS(K)=M
37400 2380 CALL RUNTHR(M)
37500 IF(EDQ.LE.0)GO TO 1860
37600 GO TO 130
37700
37800 2390 M=1
37900 IF(PLT.EQ.1)EDQ=-1
38000 PLT=0
38100 GO TO 130
38200 C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
38300
38400 2400 CALL TYPSTR(' MACRO FILE NAME= ')
38500 ACCEPT 190,K
38600 IF(K.EQ.'99')GO TO 130
38700 C TYPE 99 TO BACKUP.
38800 CALL LO2UP(K)
38900 IF(K.EQ.IBLA)K='MACRO'
39000 CALL OFILE(1,K)
39100 CALL TYPSTR(' END MACRO WITH * ')
39200 CALL TYPCRL
39300 2410 ACCEPT 700,INP
39400 IF(I1.EQ.ISTAR)GO TO 2420
39500 WRITE(1,700)INP
39600 GO TO 2410
39700 2420 END FILE 1
39800 CALL TYPSTR(' MACRO=')
39900 CALL TYPWRD(K)
40000 CALL TYPSTR('.DAT ***** RUN IT? ')
40100 ACCEPT 700,I1
40200 CALL LO2UP(I1)
40300 IF(I1.EQ.LYY)GO TO 220
40400 GO TO 130
40500
40600 CRR***2430 FORMAT(I,24F)
40700 2430 END